#
#  C o u n t s 
#

getCountsImplementationModule := proc(CountImplType:='monomial', {DefineGlobalTypes:=false})
  ################################################################################
  ###  The monomial implementation
  ################################################################################

  if CountImplType='monomial' then
    module()
       option package;
       global `b/var`, `b/var/list`;
       export UnitCount, 
              `count*`, `count/`,
              `count/f`, `count/r`, `count/length`, `count/sgn`, `transform/count`, 
              `count/normal`,
              `count/convert/inner`, `count/convert/normal`;
       export `test/count`, `test/count1`,
              `test/unitcount`, 
              `test/b/count`, `test/b/count1`, 
              `test/count/proper`, `test/count/1order`;
              # cannot use `type/...` since types are always global but we may need local types
              # i.e. types local to the instance(s) of this module
       
       # A count is a product of nonnegative integer powers, but 1 is not a count.
      
      `test/count` := proc (x) 
        local x1;  
        if type (x,`^`) then type (op(2,x), posint) 
        elif type (x,`*`) then
          for x1 in x do if not `test/count`(x1) then RETURN(false) fi od;
          true
        elif x = 1 then false
        else true
        fi
      end:
      
      `test/count1` := proc (x) `test/count`(x) or `test/unitcount`(x) end:
      
      # The unit count
      UnitCount := proc() 1 end: 
      `test/unitcount` := proc(x) evalb(x=UnitCount()) end:
      
      # A b/count is a product of nonnegative integer powers of base variables,
      # but 1 is not a b/count.
      
      `test/b/count` := proc (x) 
        local x1;  
        if type (x,`^`) then type (op(1,x),`b/var`) and type (op(2,x), posint) 
        elif type (x,`*`) then
          for x1 in x do if not procname (x1) then RETURN(false) fi od;
          true
        else type (x,`b/var`)
        fi
      end:
      
      `test/b/count1` :=  proc(x) evalb(`test/unitcount`(x) or `test/b/count`(x)) end:
     
      
      # Elementary operations with counts
      `count*` := proc(x,y) option inline; x*y end:
      `count/` := proc(x,y) option inline; x/y end:
      
      # A count is proper when it is a product or a power
      `test/count/proper` := proc(x) type(x,{`*`,`^`}) end:
            
      
      # A count is of first order when it is neither a product nor a power
      `test/count/1order` := proc(x) not `test/count/proper`(x) end:
      
      # Dealing with counts: 
      # `count/f`(x) := the first ``factor'' of the count x;
      # `count/r`(x) := x/`count/f`(x);
      # `count/length`(x) := the sum of the powers in x;
      # `count/sgn`(x) := the parity of `count/length`x;
      # `transform/count`(x) :=  the product of non-negative powers in x
      # (transforms x into 1 or count).
      
      `count/f` := proc (x)
        if type (x,`^`) then op(1,x)
        elif type (x,`*`) then `count/f`(op(1,x))
        else x
        fi
      end:
      
      `count/r` := proc (x)
        if type (x,`^`) then x/op(1,x)
        elif type (x,`*`) then x/`count/f`(op(1,x))
        else NULL
        fi
      end:
      
      `count/length` := proc (x)
        if x = 1 then 0 
        elif type (x,`^`) then op(2,x)
        elif type (x,`*`) then convert (map (`count/length`, [op(x)]), `+`)
        else 1
        fi
      end:
      
      `count/sgn` := proc (x) 1 - 2*(`count/length`(x) mod 2) end:
      
      `transform/count` := proc(x)
        local aux;
        if type (x,`^`) then if op(2,x) < 0 then 1 else x fi
        elif type (x,`*`) then aux := map(`transform/count`, x);
        else x
        fi
      end:
      
      `count/normal` := proc(x) sort(x,`b/var/list`) end:
      
      `count/convert/inner`  := proc(a) a end:
      `count/convert/normal` := proc(a) a end:
      
      if DefineGlobalTypes then 
        TypeTools:-AddType(`count`,        `test/count`);  
        TypeTools:-AddType(`unitcount`,    `test/unitcount`);  
        TypeTools:-AddType(`b/count`,      `test/b/count`); 
        TypeTools:-AddType(`b/count1`,     `test/b/count1`); 
        TypeTools:-AddType(`count/proper`, `test/count/proper`);
        TypeTools:-AddType(`count/1order`, `test/count/1order`);        
       fi;
    end module:
  

  elif DefineGlobalTypes then 
        error "only monomial global counts are supported now!";
        # since jets.s code deals implicitly with monomial counts implementation,
        # use of any different implementation in global manner is prohibited 


  ################################################################################
  ###  The indexlist implementation
  ################################################################################

  elif CountImplType='indexlist' then  
    module()
       option package;
       global `b/var`, `b/var/list`;
       export UnitCount, 
              `count*`, `count/`,
              `count/f`, `count/r`, `count/length`, `count/sgn`, `transform/count`, 
              `count/normal`,
              `count/convert/inner`, `count/convert/normal`;
       export `test/count`, `test/count1`,
              `test/unitcount`, 
              `test/b/count`, `test/b/count1`, 
              `test/count/proper`, `test/count/1order`;
       
       # A count is a product of nonnegative integer powers, but 1 is not a count.
      
      `test/count` := proc(c) `test/count1`(c) and not(`test/unitcount`(c)) end:
      
      `test/count1` := proc(c) type(c, list(nonnegint))  end:
      
      # The unit count
      UnitCount := proc() option inline; [seq(0, i=1..nops(`b/var/list`))] end: 
      
      `test/unitcount` := proc(c) evalb(c=UnitCount()) end:

            
      # A b/count is a product of nonnegative integer powers of base variables,
      # but 1 is not a b/count.
      
      `test/b/count` := proc (c)
         not(`test/unitcount`(c)) and `test/b/count1`(c)  
       end:
      
      `test/b/count1` :=  proc(c) `test/count1`(c) and nops(c)=nops(`b/var/list`) end:
      
      # Elementary operations with counts
      `count*` := proc(x,y) option inline; x+y end:
      `count/` := proc(x,y) option inline; x-y end:
      
      # A count is proper when it is a product or a power
      `test/count/proper` := proc(x) error "not implemented yet" end:
      #`test/count/proper` := proc(x) type(x,{`*`,`^`}) end:
            
      
      # A count is of first order when it is neither a product nor a power
      `test/count/1order` := proc(x) error "not implemented yet" end:
      #`test/count/1order` := proc(x) not `test/count/proper`(x) end:
      
      # Dealing with counts: 
      # `count/f`(x) := the first ``factor'' of the count x;
      # `count/r`(x) := x/`count/f`(x);
      # `count/length`(x) := the sum of the powers in x;
      # `count/sgn`(x) := the parity of `count/length`x;
      # `transform/count`(x) :=  the product of non-negative powers in x
      # (transforms x into 1 or count).
      
      `count/f` := proc(x) error "not implemented yet" end:
      #`count/f` := proc (x)
      #  if type (x,`^`) then op(1,x)
      #  elif type (x,`*`) then `count/f`(op(1,x))
      #  else x
      #  fi
      #end:
      
      `count/r` := proc(x) error "not implemented yet" end:
      #`count/r` := proc (x)
      #  if type (x,`^`) then x/op(1,x)
      #  elif type (x,`*`) then x/`count/f`(op(1,x))
      #  else NULL
      #  fi
      #end:
      
      `count/length` := proc (x)
        add(i, i=x)
      end:
      
      `count/sgn` := proc(x) error "not implemented yet" end:
      #`count/sgn` := proc (x) 1 - 2*(`count/length`(x) mod 2) end:
      
      `transform/count` := proc(x) error "not implemented yet" end:
      #`transform/count` := proc(x)
      #  local aux;
      #  if type (x,`^`) then if op(2,x) < 0 then 1 else x fi
      #  elif type (x,`*`) then aux := map(`transform/count`, x);
      #  else x
      #  fi
      #end:
      
      `count/normal` := proc(a) a end:
      `count/convert/inner` := proc(a) map2(degree, a, `b/var/list`) end:
      `count/convert/normal` := proc(a) `*`(op(zip(`^`, `b/var/list`, a))) end:
      
      if DefineGlobalTypes then 
        TypeTools:-AddType(`count`,        `test/count`);  
        TypeTools:-AddType(`unitcount`,    `test/unitcount`);  
        TypeTools:-AddType(`b/count`,      `test/b/count`); 
        TypeTools:-AddType(`b/count1`,     `test/b/count1`); 
        TypeTools:-AddType(`count/proper`, `test/count/proper`);
        TypeTools:-AddType(`count/1order`, `test/count/1order`);        
       fi;
    end module:
  
  
  else
    error "Unknown implementation name %1", CountImplType;
  fi;
end:
